home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src / tclXbsearch.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  10.6 KB  |  361 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCLExtend
  3. #endif
  4. /*
  5.  * tclXbsearch.c
  6.  *
  7.  * Extended Tcl binary file search command.
  8.  *-----------------------------------------------------------------------------
  9.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  10.  *
  11.  * Permission to use, copy, modify, and distribute this software and its
  12.  * documentation for any purpose and without fee is hereby granted, provided
  13.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14.  * Mark Diekhans make no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without express or
  16.  * implied warranty.
  17.  *-----------------------------------------------------------------------------
  18.  * $Id: tclXbsearch.c,v 2.6 1993/07/20 08:20:26 markd Exp $
  19.  *-----------------------------------------------------------------------------
  20.  */
  21.  
  22. #include "tclExtdInt.h"
  23.  
  24. /*
  25.  * Control block used to pass data used by the binary search routines.
  26.  */
  27. typedef struct binSearchCB_t {
  28.     Tcl_Interp   *interp;         /* Pointer to the interpreter.             */
  29.     char         *fileHandle;     /* Handle of file.                         */
  30.     char         *key;            /* The key to search for.                  */
  31.  
  32.     FILE         *fileCBPtr;      /* Open file structure.                    */
  33.     Tcl_DString   dynBuf;         /* Dynamic buffer to hold a line of file.  */
  34.     long          lastRecOffset;  /* Offset of last record read.             */
  35.     int           cmpResult;      /* -1, 0 or 1 result of string compare.    */
  36.     char         *tclProc;        /* Name of Tcl comparsion proc, or NULL.   */
  37.     } binSearchCB_t;
  38.  
  39. /*
  40.  * Prototypes of internal functions.
  41.  */
  42. static int
  43. StandardKeyCompare _ANSI_ARGS_((char *key,
  44.                                 char *line));
  45.  
  46. static int
  47. TclProcKeyCompare _ANSI_ARGS_((binSearchCB_t *searchCBPtr));
  48.  
  49. static int
  50. ReadAndCompare _ANSI_ARGS_((long           fileOffset,
  51.                             binSearchCB_t *searchCBPtr));
  52.  
  53. static int
  54. BinSearch _ANSI_ARGS_((binSearchCB_t *searchCBPtr));
  55.  
  56. /*
  57.  *-----------------------------------------------------------------------------
  58.  *
  59.  * StandardKeyCompare --
  60.  *    Standard comparison routine for BinSearch, compares the key to the
  61.  *    first white-space seperated field in the line.
  62.  *
  63.  * Parameters:
  64.  *   o key (I) - The key to search for.
  65.  *   o line (I) - The line to compare the key to.
  66.  *
  67.  * Results:
  68.  *   o < 0 if key < line-key
  69.  *   o = 0 if key == line-key
  70.  *   o > 0 if key > line-key.
  71.  *-----------------------------------------------------------------------------
  72.  */
  73. static int
  74. StandardKeyCompare (key, line)
  75.     char *key;
  76.     char *line;
  77. {
  78.     int  cmpResult, fieldLen;
  79.     char saveChar;
  80.  
  81.     fieldLen = strcspn (line, " \t\r\n\v\f");
  82.  
  83.     saveChar = line [fieldLen];
  84.     line [fieldLen] = 0;
  85.     cmpResult = strcmp (key, line);
  86.     line [fieldLen] = saveChar;
  87.  
  88.     return cmpResult;
  89. }
  90.  
  91. /*
  92.  *-----------------------------------------------------------------------------
  93.  *
  94.  * TclProcKeyCompare --
  95.  *    Comparison routine for BinSearch that runs a Tcl procedure to, 
  96.  *    compare the key to a line from the file.
  97.  *
  98.  * Parameters:
  99.  *   o searchCBPtr (I/O) - The search control block, the line should be in
  100.  *     dynBuf, the comparsion result is returned in cmpResult.
  101.  *
  102.  * Results:
  103.  *   TCL_OK or TCL_ERROR.
  104.  *-----------------------------------------------------------------------------
  105.  */
  106. static int
  107. TclProcKeyCompare (searchCBPtr)
  108.     binSearchCB_t *searchCBPtr;
  109. {
  110.     char *cmdArgv [3], *command, *oldResult;
  111.     int   result;
  112.  
  113.     cmdArgv [0] = searchCBPtr->tclProc;
  114.     cmdArgv [1] = searchCBPtr->key;
  115.     cmdArgv [2] = searchCBPtr->dynBuf.string;
  116.     command = Tcl_Merge (3, cmdArgv);
  117.  
  118.     result = Tcl_Eval (searchCBPtr->interp, command);
  119.  
  120.     ckfree (command);
  121.     if (result == TCL_ERROR)
  122.         return TCL_ERROR;
  123.  
  124.     if (!Tcl_StrToInt (searchCBPtr->interp->result, 0, 
  125.                        &searchCBPtr->cmpResult)) {
  126.         oldResult = ckstrdup (searchCBPtr->interp->result);
  127.  
  128.         Tcl_ResetResult (searchCBPtr->interp);
  129.         Tcl_AppendResult (searchCBPtr->interp, "invalid integer \"", oldResult,
  130.                           "\" returned from compare proc \"",
  131.                           searchCBPtr->tclProc, "\"", (char *) NULL);
  132.         ckfree (oldResult);
  133.         return TCL_ERROR;
  134.     }
  135.     Tcl_ResetResult (searchCBPtr->interp);
  136.     return TCL_OK;
  137. }
  138.  
  139. /*
  140.  *-----------------------------------------------------------------------------
  141.  *
  142.  * ReadAndCompare --
  143.  *    Search for the next line in the file starting at the specified
  144.  *    offset.  Read the line into the dynamic buffer and compare it to
  145.  *    the key using the specified comparison method.  The start of the
  146.  *    last line read is saved in the control block, and if the start of
  147.  *    the same line is found in the search, then it will not be recompared.
  148.  *    This is needed since the search algorithm has to hit the same line
  149.  *    a couple of times before failing, due to the fact that the records are
  150.  *    not fixed length.
  151.  *
  152.  * Parameters:
  153.  *   o fileOffset (I) - The offset of the next byte of the search, not
  154.  *     necessarly the start of a record.
  155.  *   o searchCBPtr (I/O) - The search control block, the comparsion result
  156.  *     is returned in cmpResult.  If the EOF is hit, a less-than result is
  157.  *     returned.
  158.  *
  159.  * Results:
  160.  *   TCL_OK or TCL_ERROR.
  161.  *-----------------------------------------------------------------------------
  162.  */
  163. static int
  164. ReadAndCompare (fileOffset, searchCBPtr)
  165.     long           fileOffset;
  166.     binSearchCB_t *searchCBPtr;
  167. {
  168.     int  recChar, status;
  169.  
  170.     if (fseek (searchCBPtr->fileCBPtr, fileOffset, SEEK_SET) != 0)
  171.         goto unixError;
  172.  
  173.     /*
  174.      * Go to beginning of next line.
  175.      */
  176.     
  177.     if (fileOffset != 0) {
  178.         while (((recChar = getc (searchCBPtr->fileCBPtr)) != EOF) &&
  179.                 (recChar != '\n'))
  180.             fileOffset++;
  181.         if ((recChar == EOF) && ferror (searchCBPtr->fileCBPtr))
  182.             goto unixError;
  183.     }
  184.     /*
  185.      * If this is the same line as before, then just leave the comparison
  186.      * result unchanged.
  187.      */
  188.     if (fileOffset == searchCBPtr->lastRecOffset)
  189.         return TCL_OK;
  190.  
  191.     searchCBPtr->lastRecOffset = fileOffset;
  192.  
  193.     Tcl_DStringFree (&searchCBPtr->dynBuf);
  194.  
  195.     status = Tcl_DStringGets (searchCBPtr->fileCBPtr,
  196.                               &searchCBPtr->dynBuf);
  197.     if (status == TCL_ERROR)
  198.         goto unixError;
  199.  
  200.     /* 
  201.      * Only compare if EOF was not hit, otherwise, treat as if we went
  202.      * above the key we are looking for.
  203.      */
  204.     if (status == TCL_BREAK) {
  205.         searchCBPtr->cmpResult = -1;
  206.         return TCL_OK;
  207.     }
  208.  
  209.     if (searchCBPtr->tclProc == NULL) {
  210.         searchCBPtr->cmpResult = StandardKeyCompare (searchCBPtr->key, 
  211.                                                      searchCBPtr->dynBuf.string);
  212.     } else {
  213.         if (TclProcKeyCompare (searchCBPtr) != TCL_OK)
  214.             return TCL_ERROR;
  215.     }
  216.  
  217.     return TCL_OK;
  218.  
  219. unixError:
  220.    Tcl_AppendResult (searchCBPtr->interp, searchCBPtr->fileHandle, ": ",
  221.                      Tcl_PosixError (searchCBPtr->interp), (char *) NULL);
  222.    return TCL_ERROR;
  223. }
  224.  
  225. /*
  226.  *-----------------------------------------------------------------------------
  227.  *
  228.  * BinSearch --
  229.  *      Binary search a sorted ASCII file.
  230.  *
  231.  * Parameters:
  232.  *   o searchCBPtr (I/O) - The search control block, if the line is found,
  233.  *     it is returned in dynBuf.
  234.  * Results:
  235.  *     TCL_OK - If the key was found.
  236.  *     TCL_BREAK - If it was not found.
  237.  *     TCL_ERROR - If there was an error.
  238.  *
  239.  * based on getpath.c from smail 2.5 (9/15/87)
  240.  *
  241.  *-----------------------------------------------------------------------------
  242.  */
  243. static int
  244. BinSearch (searchCBPtr)
  245.     binSearchCB_t *searchCBPtr;
  246. {
  247.     FILE       *filePtr;
  248.     long        middle, high, low;
  249.     struct stat statBuf;
  250.  
  251.     if (Tcl_GetOpenFile (searchCBPtr->interp, searchCBPtr->fileHandle,
  252.                          FALSE,  /* Read access  */
  253.                          TRUE,   /* Check access */
  254.                         &filePtr) != TCL_OK)
  255.         return TCL_ERROR;
  256.  
  257.     searchCBPtr->fileCBPtr = filePtr;
  258.     searchCBPtr->lastRecOffset = -1;
  259.  
  260.     if (fstat (fileno (searchCBPtr->fileCBPtr), &statBuf) < 0)
  261.         goto unixError;
  262.  
  263.     low = 0;
  264.     high = statBuf.st_size;
  265.  
  266.     /*
  267.      * "Binary search routines are never written right the first time around."
  268.      * - Robert G. Sheldon.
  269.      */
  270.  
  271.     while (TRUE) {
  272.         middle = (high + low + 1) / 2;
  273.  
  274.         if (ReadAndCompare (middle, searchCBPtr) != TCL_OK)
  275.             return TCL_ERROR;
  276.  
  277.         if (searchCBPtr->cmpResult == 0)
  278.             return TCL_OK;     /* Found   */
  279.         
  280.         if (low >= middle)  
  281.             return TCL_BREAK;  /* Failure */
  282.  
  283.         /*
  284.          * Close window.
  285.          */
  286.         if (searchCBPtr->cmpResult > 0) {
  287.             low = middle;
  288.         } else {
  289.             high = middle - 1;
  290.         }
  291.     }
  292.  
  293. unixError:
  294.    Tcl_AppendResult (searchCBPtr->interp, searchCBPtr->fileHandle, ": ",
  295.                      Tcl_PosixError (searchCBPtr->interp), (char *) NULL);
  296.    return TCL_ERROR;
  297. }
  298.  
  299. /*
  300.  *-----------------------------------------------------------------------------
  301.  *
  302.  * Tcl_BsearchCmd --
  303.  *     Implements the TCL bsearch command:
  304.  *        bsearch filehandle key ?retvar?
  305.  *
  306.  * Results:
  307.  *      Standard TCL results.
  308.  *
  309.  *-----------------------------------------------------------------------------
  310.  */
  311. int
  312. Tcl_BsearchCmd (clientData, interp, argc, argv)
  313.     ClientData  clientData;
  314.     Tcl_Interp *interp;
  315.     int         argc;
  316.     char      **argv;
  317. {
  318.     int           status;
  319.     binSearchCB_t searchCB;
  320.  
  321.     if ((argc < 3) || (argc > 5)) {
  322.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], 
  323.                           " handle key ?retvar? ?compare_proc?"
  324.                           , (char *) NULL);
  325.         return TCL_ERROR;
  326.     }
  327.  
  328.     searchCB.interp = interp;
  329.     searchCB.fileHandle = argv [1];
  330.     searchCB.key = argv [2];
  331.     searchCB.tclProc = (argc == 5) ? argv [4] : NULL;
  332.     Tcl_DStringInit (&searchCB.dynBuf);
  333.  
  334.     status = BinSearch (&searchCB);
  335.     if (status == TCL_ERROR) {
  336.         Tcl_DStringFree (&searchCB.dynBuf);
  337.         return TCL_ERROR;
  338.     }
  339.  
  340.     if (status == TCL_BREAK) {
  341.         Tcl_DStringFree (&searchCB.dynBuf);
  342.         if ((argc >= 4) && (argv [3][0] != '\0'))
  343.             interp->result = "0";
  344.         return TCL_OK;
  345.     }
  346.  
  347.     if ((argc == 3) || (argv [3][0] == '\0')) {
  348.         Tcl_DStringResult (interp, &searchCB.dynBuf);
  349.     } else {
  350.         char *varPtr;
  351.  
  352.         varPtr = Tcl_SetVar (interp, argv[3], searchCB.dynBuf.string,
  353.                              TCL_LEAVE_ERR_MSG);
  354.         Tcl_DStringFree (&searchCB.dynBuf);
  355.         if (varPtr == NULL)
  356.             return TCL_ERROR;
  357.         interp->result = "1";
  358.     }
  359.     return TCL_OK;
  360. }
  361.